Este documento consiste en una revisión del proceso de validación de EPSOC 2018. Se trata de un documento reproducible y dinámico que será actualizado cada vez que haya una nueva entrega de datos durante el trabajo de campo. El código está inserto dentro del documento, pero replegado. Para verlo hacer click en cuadro code.
Se cargan los datos en el formato entregado y se homogeneiza el formato en minúscula y usando puntos (“.”) para separar en vez de guiones bajos (“_”).
pacman::p_load(tidyverse, lubridate, anytime, chron,
haven, sf,
sjlabelled, sjmisc,
validate, eeptools, kableExtra, janitor, here, naniar,
captioner)
if(Sys.info()[["user"]] == 'caayala'){
path <- "/Users/caayala/Dropbox (DESUC)/DESUC/Proyectos/3 Politicas Publicas/EPSOC 2018/BD"
} else if(Sys.info()[["user"]] == 'Andres') {
path <- "/Users/Andres/Dropbox (DESUC)/Proyectos/3 Politicas Publicas/EPSOC 2018/BD"
}
epsoc <-haven::read_spss(file.path(path, '190404 - EPSOC Base parcial 25.sav')) %>%
clean_names() %>%
mutate(region = folio %/% 100000,
region = labelled(region,
labels = c('Antofagasta' = 2,
'Araucanía'= 9,
'Metropolitana' = 13),
label = 'Región'),
manzana = folio %/% 100,
i_1_orden = as.integer(i_1_orden))
names(epsoc) <- tolower(gsub("_", ".", names(epsoc)))
# Agregar datos de la muestra a encuesta
suppressMessages(
epsoc_muestra <- read_csv('../03-muestra_epsoc.csv')
)
epsoc <- left_join(epsoc,
epsoc_muestra %>% select(manzana = folio, estrato, sector),
by = 'manzana')
## Warning: Column `manzana` has different attributes on LHS and RHS of join
epsoc <- epsoc %>%
mutate(estrato = labelled(estrato,
labels = c('Antofagasta - Bajo' = 21,
'Antofagasta - Medio' = 22,
'Temuco - Bajo' = 91,
'Temuco - Medio' = 92,
'Gran Santiago - Bajo' = 131,
'Gran Santiago - Medio' = 132,
'Gran Santiago - Alto' = 133),
label = 'Estratos de muestreo (Ciudad - nivel educacional de los jefes de hogar de las zonas censales)'))
grabacion <- FALSE
kable_estilo <- function(tabla){
tabla %>%
kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
full_width=F)
}
makeVlist <- function(dta) {
labels <- sapply(dta, function(x) attr(x, "label"))
tibble(name = names(labels),
label = labels)
}
## Etiquetas variables
labs.epsoc <- makeVlist(epsoc)
labs.epsoc <- labs.epsoc %>%
mutate(label2 = map_chr(label, toString))
labs.epsoc <- get_label(epsoc)
La actual base cuenta con 1290 casos recogidos entre el 2018-10-17 y el 2019-03-29.
epsoc <- epsoc %>%
filter(duplicated(epsoc$folio, incomparables = FALSE) == FALSE)
epsoc %>%
count(region, status) %>%
spread(status, n) %>%
janitor::adorn_totals(where = c('row', 'col')) %>%
kable() %>%
kable_estilo()
| region | Aceptado | Aceptado con reparos | Total |
|---|---|---|---|
| 2 | 303 | 57 | 360 |
| 9 | 171 | 190 | 361 |
| 13 | 422 | 147 | 569 |
| Total | 896 | 394 | 1290 |
Distribución según estratos de muestreo
frq(epsoc, estrato)
##
## # Estratos de muestreo (Ciudad - nivel educacional de los jefes de hogar de las zonas censales) (estrato) <numeric>
## # total N=1290 valid N=1290 mean=89.61 sd=45.69
##
## val label frq raw.prc valid.prc cum.prc
## 21 Antofagasta - Bajo 252 19.53 19.53 19.53
## 22 Antofagasta - Medio 108 8.37 8.37 27.91
## 91 Temuco - Bajo 232 17.98 17.98 45.89
## 92 Temuco - Medio 129 10.00 10.00 55.89
## 131 Gran Santiago - Bajo 255 19.77 19.77 75.66
## 132 Gran Santiago - Medio 216 16.74 16.74 92.40
## 133 Gran Santiago - Alto 98 7.60 7.60 100.00
## NA NA 0 0.00 NA NA
epsoc <- epsoc %>%
mutate(rango_edad = rec(edad.seleccionado,
rec = "1:17 = 1[menor de 18 años];
18:24 = 2[18 a 24 años];
25:44 = 3[25 a 44 años];
45:59 = 4[45 a 59 años]"))
frq(epsoc, rango_edad)
##
## # rango_edad <numeric>
## # total N=1290 valid N=1289 mean=3.25 sd=0.71
##
## val label frq raw.prc valid.prc cum.prc
## 1 menor de 18 años 0 0.00 0.00 0.00
## 2 18 a 24 años 201 15.58 15.59 15.59
## 3 25 a 44 años 567 43.95 43.99 59.58
## 4 45 a 59 años 521 40.39 40.42 100.00
## NA NA 1 0.08 NA NA
epsoc %>%
filter(is.na(rango_edad)) %>%
select(sexo.seleccionado, edad.seleccionado, situacion.laboral.seleccionado)
## # A tibble: 1 x 3
## sexo.seleccionado edad.seleccionado situacion.laboral.seleccionado
## <dbl+lbl> <dbl> <dbl+lbl>
## 1 1 [Hombre] 60 1 [Trabaja]
Probablemente discrepancia de edad para las personas mayores de 59 años se debe a una confusión entre edad reportada o fecha de cumpleaños. Podría también tratarse de casos que tenían 59 años al momento de hacerse la encuesta, pero que al momento de validar los datos ya hayan cumplido los 60 .Quedarán asignados al grupo de edad rango_edad == 4.
epsoc <- epsoc %>%
mutate(rango_edad = replace(rango_edad, edad.seleccionado %in% c(60, 61), 4))
epsoc %>%
count(sexo.seleccionado, rango_edad, situacion.laboral.seleccionado) %>%
mutate_all(as_label) %>%
mutate(prop = round(n/sum(n), 4)) %>%
kable() %>%
kable_estilo()
| sexo.seleccionado | rango_edad | situacion.laboral.seleccionado | n | prop |
|---|---|---|---|---|
| Hombre | 18 a 24 años | Trabaja | 46 | 0.0357 |
| Hombre | 18 a 24 años | No trabaja | 50 | 0.0388 |
| Hombre | 25 a 44 años | Trabaja | 183 | 0.1419 |
| Hombre | 25 a 44 años | No trabaja | 18 | 0.0140 |
| Hombre | 45 a 59 años | Trabaja | 144 | 0.1116 |
| Hombre | 45 a 59 años | No trabaja | 26 | 0.0202 |
| Mujer | 18 a 24 años | Trabaja | 33 | 0.0256 |
| Mujer | 18 a 24 años | No trabaja | 72 | 0.0558 |
| Mujer | 25 a 44 años | Trabaja | 237 | 0.1837 |
| Mujer | 25 a 44 años | No trabaja | 129 | 0.1000 |
| Mujer | 45 a 59 años | Trabaja | 195 | 0.1512 |
| Mujer | 45 a 59 años | No trabaja | 157 | 0.1217 |
La distribución de la duración de las entrevistas registrada por las tablets se puede ver en la siguiente figura.
homologar_fechas <- function(fecha){
fecha %>%
str_replace_all(c("^\\D{3} " = "", '(.*)(\\d{4}$)' = '\\2 \\1')) %>%
anytime::anytime()
}
epsoc <- epsoc %>%
mutate_at(vars(starts_with('time')), homologar_fechas)
epsoc <- epsoc %>%
mutate(duration = str_replace_all(duration, c('-' = '', '^(\\d{2})' = '0\\.\\1'))) %>%
separate(duration, into = c('dura.d', 'duracion'), sep = '\\.', convert = TRUE, remove = FALSE) %>%
mutate(duracion.t = as.duration(hms(duracion) + hms(hms::hms(hour = (24 * dura.d)))))
epsoc$duracion.t.min <- epsoc$duracion.t@.Data/60
epsoc %>%
ggplot(aes(x = duracion.t.min)) +
geom_histogram(binwidth = 5) +
theme_bw() +
ggtitle("Distribución duración entrevistas por región (escala truncada < 150 minutos)") +
labs(x = "Duración total entrevista (minutos)",
y = "Frecuencia") +
coord_cartesian(xlim = 0:150) +
scale_x_continuous(breaks = seq(0, 150, by = 15)) +
facet_grid(as_factor(region) ~ .)
Existen 69 entrevistas que duran menos de 20 minutos, estas debieran ser supervisadas.
epsoc %>%
filter(as.double(duracion.t.min) < 20) %>%
select(folio, duracion.t.min) %>%
knitr::kable(col.names = c("Folio", "Duración (minutos)"),
caption = "Entrevistas de menos de 20 minutos",
digits = 1) %>%
kable_estilo() %>%
column_spec(1, width = "10em") %>%
column_spec(2, width = "10em")
| Folio | Duración (minutos) |
|---|---|
| 200329 | 19.8 |
| 201186 | 18.2 |
| 201293 | 19.7 |
| 201350 | 11.4 |
| 201434 | 19.9 |
| 201863 | 16.0 |
| 201921 | 16.4 |
| 201947 | 19.1 |
| 202382 | 19.4 |
| 202465 | 19.6 |
| 202879 | 16.4 |
| 202895 | 19.3 |
| 203190 | 18.7 |
| 203372 | 18.4 |
| 203836 | 17.9 |
| 204065 | 19.0 |
| 204396 | 19.5 |
| 204867 | 16.4 |
| 204966 | 18.6 |
| 205039 | 17.2 |
| 205443 | 19.4 |
| 205484 | 16.6 |
| 207431 | 16.9 |
| 207456 | 19.4 |
| 207464 | 14.2 |
| 207969 | 19.1 |
| 208017 | 18.5 |
| 208462 | 19.8 |
| 901025 | 20.0 |
| 901157 | 20.0 |
| 901181 | 18.1 |
| 901850 | 17.2 |
| 901868 | 17.8 |
| 902296 | 17.6 |
| 902312 | 19.2 |
| 902411 | 18.8 |
| 902452 | 19.9 |
| 902775 | 18.9 |
| 902940 | 17.9 |
| 903013 | 19.3 |
| 903088 | 20.0 |
| 903336 | 19.9 |
| 903393 | 18.1 |
| 903476 | 18.2 |
| 903518 | 19.6 |
| 903575 | 19.2 |
| 903971 | 19.3 |
| 904425 | 19.5 |
| 904755 | 17.4 |
| 905224 | 18.2 |
| 905240 | 17.6 |
| 905273 | 18.4 |
| 1301191 | 19.2 |
| 1305671 | 17.4 |
| 1305697 | 18.4 |
| 1306489 | 19.7 |
| 1309111 | 19.4 |
| 1310127 | 12.8 |
| 1310135 | 19.6 |
Existen 46 entrevistas que duran más de 150 minutos, estas debieran ser supervisadas.
epsoc %>%
filter(as.double(duracion.t.min) > 150) %>%
transmute(folio, duracion.t.min / 60) %>%
knitr::kable(col.names = c("Folio", "Duración (horas)"),
caption = "Entrevistas de más de 150 minutos",
digits = 1) %>%
kable_estilo() %>%
column_spec(1, width = "10em") %>%
column_spec(2, width = "10em")
| Folio | Duración (horas) |
|---|---|
| 200444 | 72.8 |
| 200527 | 69.8 |
| 200550 | 4.6 |
| 200717 | 49.6 |
| 202135 | 71.9 |
| 202671 | 25.7 |
| 203349 | 3.4 |
| 900183 | 2.6 |
| 902569 | 2.7 |
| 903443 | 235.0 |
| 903815 | 236.7 |
| 903922 | 91.3 |
| 903963 | 120.9 |
| 905976 | 14.3 |
| 1301928 | 18.6 |
| 1301951 | 192.9 |
| 1302157 | 4.2 |
| 1302421 | 96.4 |
| 1303254 | 25.1 |
| 1303262 | 25.6 |
| 1303643 | 24.6 |
| 1303833 | 4.0 |
| 1303999 | 6.9 |
| 1304062 | 23.6 |
| 1304732 | 24.4 |
| 1305465 | 23.4 |
| 1305515 | 72.0 |
| 1306646 | 2.8 |
| 1306877 | 44.6 |
| 1307214 | 2.5 |
| 1307339 | 218.9 |
| 1307370 | 50.1 |
| 1310192 | 13.7 |
| 1310515 | 22.6 |
| 1311471 | 5.2 |
| 1312958 | 50.4 |
Cantidad de encuestas realizadas por día.
## Comienzo encuesta
epsoc$time1.hms <- hms::as.hms(epsoc$time1)
epsoc$time1.wday <- lubridate::wday(epsoc$time1)
epsoc$time1.dmy <- date(epsoc$time1)
epsoc %>%
count(time1.dmy) %>%
mutate(n_mean = mean(n)) %>%
ggplot(aes(x = time1.dmy, y = n)) +
geom_line() +
geom_smooth(method = 'loess', formula = y ~ x) +
geom_hline(aes(yintercept = n_mean), colour = 'green') +
geom_label(aes(x = min(time1.dmy)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
labs(title = 'Número de encuestas por día') +
scale_x_date(breaks = '2 weeks') +
coord_cartesian(ylim = c(0, 40))
epsoc %>%
count(time1.wday) %>%
mutate(n_mean = mean(n)) %>%
ggplot(aes(x = time1.wday, y = n)) +
geom_line() +
geom_smooth(method = 'loess', formula = y ~ x) +
geom_hline(aes(yintercept = n_mean), colour = 'green') +
geom_label(aes(x = min(time1.wday)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
labs(title = 'Número de encuestas por día de la semana') +
scale_x_continuous(breaks = seq(7)) +
coord_cartesian(ylim = c(0, 500))
Existen 354 entrevistas sin datos de georreferenciación:
epsoc %>%
select(folio, latitude, srvyr) %>%
group_by(srvyr) %>%
mutate(n.enc = length(folio)) %>%
filter(is.na(latitude)) %>%
select(folio, srvyr, n.enc) %>%
mutate(n.enc.sg = (length(folio)/n.enc)*100) %>%
arrange(srvyr, folio) %>%
group_by_at(vars(-folio)) %>%
nest() %>%
mutate(Folio = map_chr(data, ~ flatten(.) %>% str_c(., collapse = ', '))) %>%
select(-data) %>%
kable(digits = 1,
col.names = c("Encuestador", "Total encuestas", "% sin georef.", "folios")) %>%
kable_estilo()
| Encuestador | Total encuestas | % sin georef. | folios |
|---|---|---|---|
| ageraldo.2 | 66 | 42.4 | 200857, 201376, 201475, 201715, 201939, 202143, 202465, 202598, 202770, 203034, 203042, 203083, 203216, 203224, 203240, 203315, 203331, 203570, 203877, 203885, 204040, 204081, 204289, 204297, 204719, 205237, 205252, 208512 |
| atoledo.9 | 277 | 2.9 | 901561, 902783, 903823, 903849, 904144, 904177, 904524, 906164 |
| cobando.9 | 26 | 23.1 | 903344, 903443, 903450, 903625, 903658, 906438 |
| i.perez | 24 | 33.3 | 1300433, 1301514, 1301530, 1302850, 1312610, 1312636, 1312644, 1312669 |
| j.morales | 11 | 9.1 | 1305465 |
| jossio.2 | 100 | 50.0 | 200253, 200493, 200691, 201038, 201053, 201061, 201186, 201293, 201392, 201491, 201590, 201749, 201863, 202192, 202226, 202242, 202267, 202382, 202481, 202796, 202879, 202895, 203059, 203067, 203075, 203141, 203190, 203489, 203588, 203752, 203760, 203794, 203836, 203844, 203851, 204396, 204644, 204867, 204966, 205039, 205062, 205484, 205658, 205682, 205872, 206144, 206177, 206763, 207233, 207266 |
| ksakuda.2 | 35 | 51.4 | 201483, 201921, 202473, 202788, 203323, 203372, 203380, 204016, 207415, 207423, 207431, 207449, 207456, 207464, 208017, 208033, 208041, 208058 |
| l.mancilla | 24 | 100.0 | 901520, 901546, 901553, 901579, 901595, 901868, 901876, 901884, 903112, 903120, 903138, 903146, 903153, 903161, 903179, 903187, 903195, 904342, 904367, 904375, 904383, 904391, 905257, 905281 |
| M.Alert | 5 | 100.0 | 1305234, 1305242, 1306646, 1310515, 1311471 |
| m.calderon | 2 | 100.0 | 1310226, 1311935 |
| mdiaz.2 | 85 | 7.1 | 202697, 203117, 203257, 203265, 203273, 205229 |
| mrobles.2 | 58 | 51.7 | 200212, 200477, 201111, 201772, 202218, 202234, 202275, 202572, 204339, 204818, 204875, 205013, 205047, 205450, 205468, 205666, 205690, 205864, 205948, 205963, 206110, 206151, 206318, 206623, 206631, 206714, 207647, 207712, 207936, 208314 |
| ncaceres.2 | 1 | 100.0 | 205930 |
| nicol.alarcon | 6 | 100.0 | 1310127, 1310135, 1310150, 1310168, 1310176, 1310192 |
| p.aguilera | 4 | 75.0 | 1300912, 1300953, 1303726 |
| p.gajardo | 7 | 42.9 | 1302934, 1303510, 1303528 |
| p.vegazo | 150 | 6.7 | 1300870, 1303825, 1304542, 1309111, 1309129, 1309137, 1309160, 1309178, 1311331, 1311364 |
| rfigueroa.9 | 8 | 100.0 | 901918, 901926, 902023, 902056, 902072, 905919, 905943, 905950 |
| s.gonzalez | 16 | 75.0 | 1301910, 1301928, 1301936, 1301944, 1301951, 1301969, 1302066, 1303916, 1303940, 1303965, 1305911, 1307057 |
| v.becerra | 2 | 100.0 | 1300672, 1300698 |
| v.espinoza | 103 | 2.9 | 1304575, 1310572, 1310580 |
| v.sierra | 171 | 69.0 | 1300151, 1300169, 1300177, 1300185, 1300193, 1300250, 1300268, 1300276, 1300284, 1300292, 1300474, 1300482, 1300490, 1300557, 1300565, 1300573, 1300581, 1300599, 1300789, 1300797, 1301373, 1301381, 1301399, 1301571, 1301589, 1301597, 1301779, 1301787, 1301795, 1301878, 1301894, 1302074, 1302082, 1302090, 1302470, 1302488, 1302496, 1302678, 1302686, 1302694, 1302777, 1302785, 1302793, 1303155, 1303163, 1303171, 1303189, 1303197, 1303676, 1303684, 1303692, 1303775, 1303783, 1303791, 1303973, 1303999, 1304161, 1304187, 1304195, 1304484, 1304492, 1305077, 1305085, 1305093, 1305994, 1306042, 1306059, 1306067, 1306075, 1306083, 1306091, 1306117, 1306281, 1306299, 1306356, 1306364, 1306372, 1306380, 1306398, 1306596, 1306679, 1306695, 1306851, 1306869, 1307172, 1307180, 1307198, 1307214, 1307230, 1307263, 1307271, 1307289, 1307297, 1308642, 1308659, 1308667, 1308675, 1308683, 1308691, 1308915, 1308923, 1308931, 1308949, 1308956, 1308964, 1308972, 1308980, 1308998, 1310366, 1310374, 1310382, 1311158, 1311166, 1311174, 1311182, 1311190, 1312685, 1312693 |
| ycifuente.9 | 4 | 50.0 | 901314, 901322 |
epsoc_geo <- epsoc %>%
select(folio, sbj.num, region, srvyr, longitude, latitude) %>%
filter(!is.na(latitude)) %>%
sf::st_as_sf(coords = c('longitude', 'latitude'),
crs = "+proj=longlat +ellps=GRS80")
sf::write_sf(epsoc_geo,
here::here('validacion_epsoc_puntos_respuesta.kml'),
dataset_options=c("NameField=folio"),
delete_dsn=TRUE)
epsoc_geo %>%
filter(region == 2) %>%
ggplot(aes(color = srvyr)) +
geom_sf()
epsoc_geo %>%
filter(region == 9) %>%
ggplot(aes(color = srvyr)) +
geom_sf()
epsoc_geo %>%
filter(region == 13) %>%
ggplot(aes(color = srvyr)) +
geom_sf()
EPSOC contiene dos experimentos que constituyen un foco de análisis del instrumento. El primer experimento consiste en un diseño factorial a través viñetas. El segundo se trata de una aleatorización del orden de preguntas sobre recompensa percibida y justa para tres objetos de evaluación: un obrero, un presidente de empresa y el respondente. Actualmente no es posible validar estos experimento por falta de información.
Para validar el proceso con las viñetas necesitamos:
Revisar la distribución efectiva captada de los decks de viñetas en terreno hasta el momento.
epsoc %>%
select(folio, i.1.grupo) %>%
head()
## # A tibble: 6 x 2
## folio i.1.grupo
## <dbl> <chr>
## 1 200139 23
## 2 200147 17
## 3 200162 11
## 4 200212 15
## 5 200220 15
## 6 200238 31
epsoc %>%
transmute(i.1.grupo = as.integer(i.1.grupo),
region) %>%
group_by_all() %>%
count() %>%
group_by(region) %>%
mutate(n_mean = mean(n)) %>%
ggplot(aes(x = as_factor(i.1.grupo), y = n)) +
geom_col() +
geom_hline(aes(group = region, yintercept = n_mean), colour = 'green') +
geom_text(aes(label = ..y..), nudge_y = 1, size = 3) +
facet_grid(rows = vars(region)) +
labs(title = 'Distribución de viñetas')
## Don't know how to automatically pick scale for object of type haven_labelled. Defaulting to continuous.
time2 y time3 no siguen un formato homogéneo para registrar la hora. Por ejemplo, en algún caso se utiliza el formato “2018-10-27T19:05:08-03:00” y en otros “Fri Oct 19 13:01:59 -0300 2018”## Comienzo viñetas
epsoc$time2.hms <- hms::as.hms(epsoc$time2)
epsoc$time2.dmy <- date(epsoc$time2)
## Fin viñetas
epsoc$time3.hms <- hms::as.hms(epsoc$time3)
epsoc$time3.dmy <- date(epsoc$time3)
epsoc$dura.vinetas <- difftime(epsoc$time3, epsoc$time2,
units = "mins")
ggplot(epsoc, aes(x = time2.dmy, y = time2.hms)) +
geom_point(alpha = 0.6) +
labs(x = "Día", y = "Hora") +
ggtitle("Día y hora comienzo actividad viñetas") +
theme_bw()
ggplot(epsoc, aes(x = srvyr, y = time2.hms)) +
geom_point(alpha = 0.6) +
labs(x = "Encuestador", y = "Hora") +
ggtitle("Hora comienzo actividad viñetas según encuestador") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))
epsoc %>%
mutate(vin.cort = ifelse(dura.vinetas < 5, "< 5'", ">= 5'")) %>%
ggplot(aes(dura.vinetas)) +
geom_histogram(aes(fill = vin.cort)) + theme_bw() +
theme(legend.title=element_blank()) +
ggtitle("Duración ejercicio viñetas") +
xlab("Minutos")
Como se puede ver en la figura anterior, la distribución del tiempo de duración del ejercicio de viñetas es variable. En términos de validación, llama la atención que se logre realizar el ejercicio en menos de cinco minutos. Estos casos deberían ser revisados apenas sea posible.
ggplot(epsoc, aes(x = srvyr, y = if_else(dura.vinetas < 60, dura.vinetas, 60),
colour = status)) +
geom_point(alpha = 0.5,
position = position_jitter(width = .2)) +
scale_color_manual(values = c('green', 'orange', 'blue')) +
facet_grid(cols = vars(region), scales = 'free_x', space = 'free_x') +
labs(x = "Encuestador", y = "minutos") +
ggtitle("Duración de actividad viñetas según encuestador según región") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))
## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.
En particular, deben supervisarse las siguientes entrevistas donde el ejercicio duró menos de 4 minutos:
kable(epsoc %>%
group_by(srvyr) %>%
mutate(n.enc = length(folio)) %>%
select(folio, dura.vinetas, srvyr, n.enc) %>%
filter(dura.vinetas <= 4) %>%
mutate(n.enc.cort = (length(folio)/n.enc)*100) %>%
arrange(srvyr, dura.vinetas),
digits = 1,
col.names = c("Folio", "Duración viñetas", "Encuestador", "Total encuestas", "% cortas"),
caption = "Ejercicio viñetas de menos de 5 minutos") %>%
kable_estilo() #%>%
| Folio | Duración viñetas | Encuestador | Total encuestas | % cortas |
|---|---|---|---|---|
#column_spec(1, width = "10em") %>%
#column_spec(2, width = "10em") %>%
#column_spec(3, width = "10em")
labels_correcion <- function(.vect) {
replace(.vect, .vect == 6, -1) %>%
remove_labels(labels = '- 1') %>%
add_labels(labels = c('- 1' = -1))
}
gg_ideologia_orden <- function(.data, var_orden, miss = 88){
var_orden_quo <- enquo(var_orden)
.data %>%
gather('variable', 'valor', -!!var_orden_quo) %>%
filter(valor < miss) %>%
ggplot(aes(x = valor)) +
geom_bar() +
facet_grid(rows = vars(variable),
cols = vars(!!var_orden_quo))
}
ideologia_ego <- list(orden1 = c("c0.1", "c1.1.1", "c1.2.1", "c1.3.1", "c1.4.1", "c2.1.1", "c2.2.1", "c2.3.1", "c2.4.1"),
orden2 = c("c0.2", "c1.4.2", "c1.1.2", "c1.2.2", "c1.3.2", "c2.4.2", "c2.1.2", "c2.2.2", "c2.3.2"),
orden3 = c("c0.3", "c1.3.3", "c1.4.3", "c1.1.3", "c1.2.3", "c2.3.3", "c2.4.3", "c2.1.3", "c2.2.3"),
orden4 = c("c0.4", "c1.2.4", "c1.3.4", "c1.4.4", "c1.1.4", "c2.2.4", "c2.3.4", "c2.4.4", "c2.1.4"))
df_ideologia_ego <- epsoc %>%
select(folio, i.1.orden, !!!flatten_chr(ideologia_ego)) %>%
nest(-i.1.orden) %>%
arrange(i.1.orden)
df_ideologia_ego <- df_ideologia_ego %>%
mutate(orden = ideologia_ego[str_glue("orden{i.1.orden + 1}")],
data = map2(data, orden, ~select(.x, one_of("folio", .y))),
data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))
df_ideologia_ego
## # A tibble: 4 x 4
## i.1.orden data orden data_var
## <int> <list> <list> <chr>
## 1 0 <tibble [305… <chr [… folio, c0.1, c1.1.1, c1.2.1, c1.3.1, c1.…
## 2 1 <tibble [346… <chr [… folio, c0.2, c1.4.2, c1.1.2, c1.2.2, c1.…
## 3 2 <tibble [329… <chr [… folio, c0.3, c1.3.3, c1.4.3, c1.1.3, c1.…
## 4 3 <tibble [310… <chr [… folio, c0.4, c1.2.4, c1.3.4, c1.4.4, c1.…
map_dfc(df_ideologia_ego$data, get_label) %>%
mutate_all(str_trunc, width = 25)
## # A tibble: 10 x 4
## V1 V2 V3 V4
## <chr> <chr> <chr> <chr>
## 1 "" "" "" ""
## 2 Observe esta esca… Observe esta esc… Observe esta esc… Observe esta esc…
## 3 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
## 4 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
## 5 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 6 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
## 7 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
## 8 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
## 9 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 10 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
suppressWarnings(
df_ideologia_ego <- df_ideologia_ego %>%
mutate(data = map(data, ~rename_all(.x, ~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))) %>%
select(data) %>%
unnest()
)
df_ideologia_ego <- copy_labels(df_new = df_ideologia_ego,
df_origin = epsoc %>%
select(one_of(c('folio', ideologia_ego$orden1))) %>%
rename_all(~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))
Agregar variables reconstruidas a base de datos.
epsoc <- left_join(epsoc,
df_ideologia_ego,
by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join
epsoc %>%
select(i.1.orden, matches("c[1-2].\\d{1}$")) %>%
gather('variable', 'valor', -i.1.orden) %>%
mutate(referencia = if_else(str_detect(variable, 'c1.*'), 'ego', 'alter'),
outcome = str_extract(variable, '(\\d*)$')) %>%
filter(valor < 88) %>%
ggplot(aes(x = valor, fill = fct_rev(referencia))) +
geom_bar(position = position_dodge()) +
facet_grid(rows = vars(outcome),
cols = vars(i.1.orden)) +
labs(title = 'Distribución de viñetas ego y alter, según orden de preguntas') +
scale_fill_discrete(name = 'Referencia')
## Warning: attributes are not identical across measure variables;
## they will be dropped
Primero es necesario reunir las variables
ideologia_vin <- list(orden1 = c(1, 2, 3, 4),
orden2 = c(4, 1, 2, 3),
orden3 = c(3, 4, 1, 2),
orden4 = c(2, 3, 4, 1))
df_ideologia_vin <- epsoc %>%
select(folio, i.1.orden, matches("^c([3-9]|10)\\.[1-4].*")) %>%
nest(-i.1.orden) %>%
arrange(i.1.orden)
ideologia_variables <- function(persona, orden, grupo){
expand.grid(persona, orden, grupo) %>%
arrange(Var1) %>%
str_glue_data("c{Var1}.{Var2}.{Var3}")
}
df_ideologia_vin <- df_ideologia_vin %>%
mutate(orden = ideologia_vin[str_glue("orden{i.1.orden + 1}")],
variables = map2(orden, i.1.orden + 1, ~ideologia_variables(3:10, .x, .y)),
data = map2(data, variables, ~select(.x, one_of("folio", .y))),
data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))
df_ideologia_vin %>%
select(i.1.orden, data_var)
## # A tibble: 4 x 2
## i.1.orden data_var
## <int> <chr>
## 1 0 folio, c3.1.1, c3.2.1, c3.3.1, c3.4.1, c4.1.1, c4.2.1, c4.3.1,…
## 2 1 folio, c3.4.2, c3.1.2, c3.2.2, c3.3.2, c4.4.2, c4.1.2, c4.2.2,…
## 3 2 folio, c3.3.3, c3.4.3, c3.1.3, c3.2.3, c4.3.3, c4.4.3, c4.1.3,…
## 4 3 folio, c3.2.4, c3.3.4, c3.4.4, c3.1.4, c4.2.4, c4.3.4, c4.4.4,…
etiquetas <- map(df_ideologia_vin$data, get_labels)
ideologia_vin1_names <- names(df_ideologia_vin$data[[1]])
ideologia_vin1_gen_names <- str_remove(ideologia_vin1_names, '.\\d{1,2}$')
suppressWarnings(
df_ideologia_vin <- df_ideologia_vin %>%
mutate(data = map(data, ~rename_all(.x, ~ideologia_vin1_gen_names))) %>%
select(data) %>%
unnest()
)
df_ideologia_vin <- copy_labels(df_new = df_ideologia_vin,
df_origin = epsoc %>%
select(!!!ideologia_vin1_names) %>%
rename_all(~ideologia_vin1_gen_names))
head(df_ideologia_vin)
## # A tibble: 6 x 33
## folio c3.1 c3.2 c3.3 c3.4 c4.1 c4.2 c4.3 c4.4 c5.1 c5.2 c5.3
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 200162 1 1 11 1 1 1 11 1 11 1 1
## 2 200238 11 10 1 2 2 1 11 11 3 3 10
## 3 200246 11 1 11 1 1 11 11 11 11 1 1
## 4 200329 4 11 10 3 4 9 3 3 8 3 10
## 5 200337 2 2 1 1 6 10 1 1 1 9 3
## 6 200410 1 1 1 1 11 11 1 1 11 11 1
## # … with 21 more variables: c5.4 <dbl>, c6.1 <dbl>, c6.2 <dbl>,
## # c6.3 <dbl>, c6.4 <dbl>, c7.1 <dbl>, c7.2 <dbl>, c7.3 <dbl>,
## # c7.4 <dbl>, c8.1 <dbl>, c8.2 <dbl>, c8.3 <dbl>, c8.4 <dbl>,
## # c9.1 <dbl>, c9.2 <dbl>, c9.3 <dbl>, c9.4 <dbl>, c10.1 <dbl>,
## # c10.2 <dbl>, c10.3 <dbl>, c10.4 <dbl>
Agregar variables reconstruidas a base de datos.
epsoc <- left_join(epsoc,
df_ideologia_vin,
by = 'folio')
## Warning: Column `folio` has different attributes on LHS and RHS of join
Gráficos para comparar distribuciones entre viñetas y orden
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).1$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Familias, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).2$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Orden o Cambio, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).3$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Educación, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
epsoc %>%
select(i.1.orden, matches('c([3-9]|10).4$')) %>%
gg_ideologia_orden(i.1.orden) +
labs(title = 'Distribución de viñetas Grandes Empresas, según orden de preguntas')
## Warning: attributes are not identical across measure variables;
## they will be dropped
Para validar el experimento de evaluación de justicia necesitamos: - Una breve explicación de cómo están codificados los items de recompensa percibida y recompensa justa para un obrero, el presidente de una empresa y el respondente - Es fundamental saber cuál es la variable que define el orden en que se presentó una y otra pregunta
La variable a que determina el tratamiento mostrado en la encuesta es la variable num.grupo.jd.
flat_table(epsoc, num.grupo.jd, region, margin = 'col')
## region Antofagasta Araucanía Metropolitana
## num.grupo.jd
## 0 26.39 19.94 23.02
## 1 24.17 24.38 26.01
## 2 28.06 27.98 25.31
## 3 21.39 27.70 25.66
Existen 24 variables asociadas al experimiento de recompensa justa que se detallan a continuación:
var_rec_justa <- find_var(epsoc, pattern = stringr::regex('obrero|pdte'), search = 'label')
var_rec_justa$var.label %>%
str_replace_all(c('Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos u ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos' = 'cuánto dinero cree Ud. que ganan',
'Pensando en lo que Ud. cree que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos. ' = '')) %>%
paste0(var_rec_justa$var.name, " - ", sort(rep(seq(6), 4)), " - ", .)
## [1] "i.1.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [2] "i.2.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (obrero)"
## [3] "i.1.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [4] "i.2.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (obrero)?"
## [5] "i.1.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [6] "i.2.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (obrero)?"
## [7] "i.1.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [8] "i.2.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (obrero)"
## [9] "i.1.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [10] "i.2.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (obrero)"
## [11] "i.1.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [12] "i.2.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (obrero)?"
## [13] "i.1.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [14] "i.2.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (obrero)?"
## [15] "i.1.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [16] "i.2.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (obrero)"
## [17] "i.1.g1a.3.2.rec - 5 - cuánto dinero cree Ud. que ganan (obrero)"
## [18] "i.2.g1a.3.2.rec - 5 - cuánto dinero cree Ud. que ganan (pdte empresa)"
## [19] "i.1.g1b.3.2.rec - 5 - ¿Cuál sería una remuneración justa para (obrero)?"
## [20] "i.2.g1b.3.2.rec - 5 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [21] "i.1.g2b.4.2.rec - 6 - ¿Cuál sería una remuneración justa para (obrero)?"
## [22] "i.2.g2b.4.2.rec - 6 - ¿Cuál sería una remuneración justa para (pdte empresa)?"
## [23] "i.1.g2a.4.2.rec - 6 - cuánto dinero cree Ud. que ganan (obrero)"
## [24] "i.2.g2a.4.2.rec - 6 - cuánto dinero cree Ud. que ganan (pdte empresa)"
Al inicio de la aplicación del cuestionario se implementó 4 grupos (del grupo 1 al 4 o variables i.1.g1a.1.rec a i.2.g1a.4.rec). Como puede verse el grupo 3 es identico al 1 y el grupo 4 es igual al 2 porque se mantuvo el orden de presidente empresa y luego obrero.
Para solucionarlo, se agregaron los grupos 5 y 6 en donde se se cambia el orden a obrero y luego presidente empresa. Con esto los 4 grupos (1, 2, 5 y 6) a los que cada persona se verá confrontada serán diferentes. Como se puede ver en el gráfico , la implementación del cambio se efectuó correctamente.
epsoc %>%
arrange(num.grupo.jd, time1) %>%
select(one_of(var_rec_justa$var.name)) %>%
naniar::vis_miss() +
labs(title = 'Distribución de respuestas en preguntas de recompensa justa') +
theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 0))
La encuesta considera una serie de preguntas con escalas predefinidas. A continuación se revisa que los ítems sobre justicia tengan respuestas en el rango de 1 a 5 o bien valores de 8 o 9.
item_just <- find_var(epsoc, "usto")
item_just$var.name
## [1] "i.6.a1" "i.8.a1" "i.9.a1" "i.10.a1" "i.11.a1" "i.12.a1" "i.13.a1"
## [8] "i.16.a1" "i.1.h1" "i.2.h1" "i.5.h1" "i.7.h1" "i.8.h1" "i.10.h1"
## [15] "i.11.h1" "i.12.h1" "i.14.h1"
v <- validator(j := var_group(i.6.a1, i.8.a1, i.9.a1, i.10.a1, i.11.a1, i.12.a1, i.13.a1, i.16.a1,
i.1.h1, i.2.h1, i.5.h1, i.7.h1, i.8.h1, i.10.h1, i.11.h1, i.12.h1, i.14.h1),
j >= 1,
j <= 9,
j != 6,
j != 7)
cf2 <- confront(epsoc, v)
s.cf2 <- summary(cf2)
knitr::kable(s.cf2) %>%
kable_estilo()
| name | items | passes | fails | nNA | error | warning | expression |
|---|---|---|---|---|---|---|---|
| V2.1 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.6.a1 - 1) >= -1e-08 |
| V2.2 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.8.a1 - 1) >= -1e-08 |
| V2.3 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.9.a1 - 1) >= -1e-08 |
| V2.4 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.10.a1 - 1) >= -1e-08 |
| V2.5 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.11.a1 - 1) >= -1e-08 |
| V2.6 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.12.a1 - 1) >= -1e-08 |
| V2.7 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.13.a1 - 1) >= -1e-08 |
| V2.8 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.16.a1 - 1) >= -1e-08 |
| V2.9 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.1.h1 - 1) >= -1e-08 |
| V2.10 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.2.h1 - 1) >= -1e-08 |
| V2.11 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.5.h1 - 1) >= -1e-08 |
| V2.12 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.7.h1 - 1) >= -1e-08 |
| V2.13 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.8.h1 - 1) >= -1e-08 |
| V2.14 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.10.h1 - 1) >= -1e-08 |
| V2.15 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.11.h1 - 1) >= -1e-08 |
| V2.16 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.12.h1 - 1) >= -1e-08 |
| V2.17 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.14.h1 - 1) >= -1e-08 |
| V3.1 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.6.a1 - 9) <= 1e-08 |
| V3.2 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.8.a1 - 9) <= 1e-08 |
| V3.3 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.9.a1 - 9) <= 1e-08 |
| V3.4 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.10.a1 - 9) <= 1e-08 |
| V3.5 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.11.a1 - 9) <= 1e-08 |
| V3.6 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.12.a1 - 9) <= 1e-08 |
| V3.7 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.13.a1 - 9) <= 1e-08 |
| V3.8 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.16.a1 - 9) <= 1e-08 |
| V3.9 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.1.h1 - 9) <= 1e-08 |
| V3.10 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.2.h1 - 9) <= 1e-08 |
| V3.11 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.5.h1 - 9) <= 1e-08 |
| V3.12 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.7.h1 - 9) <= 1e-08 |
| V3.13 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.8.h1 - 9) <= 1e-08 |
| V3.14 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.10.h1 - 9) <= 1e-08 |
| V3.15 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.11.h1 - 9) <= 1e-08 |
| V3.16 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.12.h1 - 9) <= 1e-08 |
| V3.17 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | (i.14.h1 - 9) <= 1e-08 |
| V4.1 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.6.a1 != 6 |
| V4.2 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.8.a1 != 6 |
| V4.3 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.9.a1 != 6 |
| V4.4 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.10.a1 != 6 |
| V4.5 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.11.a1 != 6 |
| V4.6 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.12.a1 != 6 |
| V4.7 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.13.a1 != 6 |
| V4.8 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.16.a1 != 6 |
| V4.9 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.1.h1 != 6 |
| V4.10 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.2.h1 != 6 |
| V4.11 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.5.h1 != 6 |
| V4.12 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.7.h1 != 6 |
| V4.13 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.8.h1 != 6 |
| V4.14 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.10.h1 != 6 |
| V4.15 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.11.h1 != 6 |
| V4.16 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.12.h1 != 6 |
| V4.17 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.14.h1 != 6 |
| V5.1 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.6.a1 != 7 |
| V5.2 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.8.a1 != 7 |
| V5.3 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.9.a1 != 7 |
| V5.4 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.10.a1 != 7 |
| V5.5 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.11.a1 != 7 |
| V5.6 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.12.a1 != 7 |
| V5.7 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.13.a1 != 7 |
| V5.8 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.16.a1 != 7 |
| V5.9 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.1.h1 != 7 |
| V5.10 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.2.h1 != 7 |
| V5.11 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.5.h1 != 7 |
| V5.12 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.7.h1 != 7 |
| V5.13 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.8.h1 != 7 |
| V5.14 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.10.h1 != 7 |
| V5.15 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.11.h1 != 7 |
| V5.16 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.12.h1 != 7 |
| V5.17 | 1290 | 1290 | 0 | 0 | FALSE | FALSE | i.14.h1 != 7 |
Existen 0 variables de actitudes sobre justicia fuera de rango.
Para validar los datos consideramos los siguientes criterios:
epsoc$duration <- chron(times=epsoc$duration)
## Warning in convert.times(times., fmt): NAs introduced by coercion
## Warning in convert.times(times., fmt): time-of-day entries out of range in
## positions NA,NA,NA,NA,NA,NA,NA,NA,NA,NA set to NA
cf <- check_that(epsoc, edad.seleccionado <= 59 & edad.seleccionado >= 18,
sexo.enc == sexo.seleccionado)
s.cf <- summary(cf)
knitr::kable(s.cf) %>%
kable_estilo()
| name | items | passes | fails | nNA | error | warning | expression |
|---|---|---|---|---|---|---|---|
| V1 | 1290 | 1289 | 1 | 0 | FALSE | FALSE | edad.seleccionado <= 59 & edad.seleccionado >= 18 |
| V2 | 1290 | 1278 | 12 | 0 | FALSE | FALSE | abs(sexo.enc - sexo.seleccionado) < 1e-08 |
Resultados:
sexo.enc y sexo.seleccionado.## Fecha de nacimiento y edad seleccionado
epsoc$enc.edad[as.character(epsoc$enc.edad) == "1582-10-14"] <- NA # comportamiento extraño al importar desde SPSS
edad <- tibble(Folio = epsoc$folio[is.na(epsoc$enc.edad)],
Fecha = epsoc$enc.edad[is.na(epsoc$enc.edad)],
Edad = epsoc$edad.seleccionado[is.na(epsoc$enc.edad)])
knitr::kable(edad,
caption = "Casos sin fecha de nacimiento en `enc_edad`",
col.names = c("Folio", "Fecha nacimiento", "Edad")) %>%
kable_estilo()
| Folio | Fecha nacimiento | Edad |
|---|---|---|
| 201350 | NA | 56 |
| 201467 | NA | 59 |
| 202457 | NA | 18 |
| 202580 | NA | 59 |
| 203182 | NA | 39 |
| 203273 | NA | 59 |
| 203315 | NA | 52 |
| 205237 | NA | 59 |
| 900134 | NA | 59 |
| 900753 | NA | 53 |
| 900779 | NA | 59 |
| 900829 | NA | 40 |
| 900845 | NA | 59 |
| 900878 | NA | 59 |
| 901041 | NA | 59 |
| 901066 | NA | 59 |
| 901082 | NA | 39 |
| 901132 | NA | 59 |
| 901181 | NA | 18 |
| 901579 | NA | 40 |
| 901876 | NA | 59 |
| 901918 | NA | 25 |
| 902338 | NA | 56 |
| 902361 | NA | 59 |
| 902379 | NA | 59 |
| 902411 | NA | 59 |
| 902429 | NA | 59 |
| 902478 | NA | 59 |
| 902510 | NA | 59 |
| 902759 | NA | 36 |
| 902924 | NA | 59 |
| 903336 | NA | 59 |
| 903351 | NA | 59 |
| 903419 | NA | 59 |
| 903518 | NA | 59 |
| 903526 | NA | 59 |
| 903567 | NA | 59 |
| 903955 | NA | 59 |
| 904144 | NA | 56 |
| 904383 | NA | 53 |
| 904565 | NA | 43 |
| 904631 | NA | 59 |
| 904649 | NA | 58 |
| 904664 | NA | 59 |
| 904698 | NA | 59 |
| 904722 | NA | 59 |
| 904771 | NA | 59 |
| 905224 | NA | 59 |
| 905273 | NA | 59 |
| 905299 | NA | 59 |
| 905364 | NA | 59 |
| 905422 | NA | 59 |
| 905448 | NA | 59 |
| 905471 | NA | 51 |
| 905877 | NA | 20 |
| 905976 | NA | 59 |
| 1302538 | NA | 47 |
| 1303270 | NA | 34 |
| 1303577 | NA | 39 |
| 1309913 | NA | 49 |
| 1310150 | NA | 55 |
| 1310168 | NA | 27 |
| 1310176 | NA | 52 |
| 1310192 | NA | 35 |
| 1311935 | NA | 24 |
| 1312438 | NA | 48 |
epsoc %>%
filter(sexo.enc != sexo.seleccionado) %>%
select(Folio = folio, sexo.enc, sexo.seleccionado) %>%
knitr::kable(col.names = c("Folio", "sexo.enc", "sexo.seleccionado"),
caption = "Entrevistas donde sexo encuestado y seleccionado no coinciden") %>%
kable_estilo()
| Folio | sexo.enc | sexo.seleccionado |
|---|---|---|
| 200444 | 1 | 2 |
| 201483 | 1 | 2 |
| 201939 | 2 | 1 |
| 205237 | 2 | 1 |
| 902213 | 1 | 2 |
| 1301928 | 2 | 1 |
| 1301936 | 2 | 1 |
| 1301944 | 2 | 1 |
| 1301969 | 1 | 2 |
| 1305911 | 2 | 1 |
| 1307131 | 2 | 1 |
| 1309913 | 1 | 2 |
frq(epsoc$f22)
##
## # ¿Tiene usted hijos o hijas? ¿Cuántos/as? (x) <numeric>
## # total N=1290 valid N=1290 mean=2.72 sd=1.45
##
## val label frq raw.prc valid.prc cum.prc
## 1 No, ninguno 331 25.66 25.66 25.66
## 2 Uno/a 270 20.93 20.93 46.59
## 3 Dos 334 25.89 25.89 72.48
## 4 Tres 220 17.05 17.05 89.53
## 5 Cuatro 90 6.98 6.98 96.51
## 6 Cinco 22 1.71 1.71 98.22
## 7 Seis o más 19 1.47 1.47 99.69
## 8 No sabe [No leer] 1 0.08 0.08 99.77
## 9 No responde [No leer] 3 0.23 0.23 100.00
## NA NA 0 0.00 NA NA
hijos <- epsoc %>%
select(folio, f22:f26.o5) %>%
mutate(hijo_n = ifelse(f22 <= 6, f22 - 1, NA),
hijo_estudia = ifelse(f23 <= 7, f23 - 1, NA),
hijo_egreso = ifelse(f25 <= 7, f25 - 1, NA),
hijo_suma = hijo_estudia + hijo_egreso) %>%
filter(hijo_n < hijo_suma)
hijos %>%
select(folio, starts_with('hijo')) %>%
arrange(desc(abs(hijo_n - hijo_suma)))
## # A tibble: 0 x 5
## # … with 5 variables: folio <dbl>, hijo_n <dbl>, hijo_estudia <dbl>,
## # hijo_egreso <dbl>, hijo_suma <dbl>
epsoc <- epsoc %>%
mutate(situacion.laboral.seleccionado.2 = rec(f2,
rec = "1:3 = 1[Trabaja];
4 = 2 [No trabaja];
8 = 2 [No trabaja];
9 = 2 [No trabaja];
else = 3 [Caso especial]"))
epsoc %>%
flat_table(situacion.laboral.seleccionado,situacion.laboral.seleccionado.2)
## situacion.laboral.seleccionado.2 Trabaja No trabaja Caso especial
## situacion.laboral.seleccionado
## Trabaja 797 8 33
## No trabaja 55 92 305
Grabar base de datos con variables de viñetas reconstruidas.
epsoc %>%
mutate_if(is.numeric, as_labelled) %>%
haven::write_sav(file.path(path, "EPSOC Base parcial con vinetas.sav"))
archivos <- dir(path = file.path(path, 'SurveyToGo Attachments', 'EPSOC'),
recursive = TRUE)
# Códigos de encuestas válidas
epsoc_sbj.num_sort <- paste0("S", sort(epsoc$sbj.num))
# Extracción de archivos válidos
archivos_Validos <- archivos[(str_extract(archivos, "(?=S).*(?=_)") %in% epsoc_sbj.num_sort)]
copia <- file.copy(from = file.path(path, 'SurveyToGo Attachments', 'EPSOC', archivos_Validos),
to = file.path(path, "Validacion-EPSOC", "grabaciones"),
overwrite = TRUE)
sum(copia)